# Little script to create some statistics from Mechwarrior4 server logfiles
# Reporting is based on the Game-ID
# Additional heuristics to combine multiple Game-IDs of the same player MAY follow

use warnings;
use strict;
use List::MoreUtils;
use Date::Manip;

# left in for finding future data oddities
# local( $SIG{__WARN__} )= sub { die $! };

# Input file is the first argument, assume sensible default when blank
my $ifile = $ARGV[0] || get_user_input( "Please enter the name of the log file.", "PlayerLog.txt" );

# Output file is the first argument, assume sensible default when blank
my $ofile = $ARGV[1] || get_user_input( "Please enter the name of the statistics file.", "PlayerStats.txt" );

# Do da work
write_stats( $ofile, do_stats( $ifile ) );

# Open output file in Notepad 
system( "notepad", $ofile );

# Read Log and write Statistics to file
sub write_stats
{
	# Output file name
	my $ofile  = shift;

	# Statistical data
	my $stats  = shift;

	open my $out, ">", $ofile 
		or die "Can't write output file ($ofile)";

	# Write output header
	print $out "ID\tLastConnect\tLastDisconnect\tConnections\tPlayingTime\tNoOfNames\tNames\n";

	# Iterate data and write it out as CSV
	foreach my $id ( sort { $stats->{$b}->{last_connect} cmp $stats->{$a}->{last_connect} } keys %{$stats} )
	{
		my @names = @{ $stats->{$id}->{names} };
		print $out join( "\t", 
			$id, 
			$stats->{$id}->{last_connect}, 
			$stats->{$id}->{last_disconnect}||$stats->{$id}->{last_connect}, 
			$stats->{$id}->{connections}, 
			seconds_to_readable_time( $stats->{$id}->{playing_time} ), 
			scalar @names, 
			join( ",", map { $_->[0] . " (". $_->[1] .")" } sort { $b->[1] <=> $a->[1] } @names ) 
		), "\n";
	}
}

# Create statistics from input file
sub do_stats
{
	# Name of input file
	my $file = shift;
	
	# Hash to hold player data per gameid
	my %players;

	# Iterate parsed records
	foreach my $record ( parse_log( $ifile ) )
	{
		my $id     = $record->{ id1 };
		my $name   = $record->{ name };
		my $status = $record->{ status };

		# Add a new player-id when found 
		unless ( $players{$id} )
		{
			$players{$id} = { names =>[], connections => 0, playing_time => 0 };
		}

		# Add a new name of the player, unless previously added
		my @found = grep { $_->[0] eq $name } @{ $players{$id}{names} };
		
		# Keep track of online time
		if ( $status eq "CONNECTED" )
		{
		
			if ( @found )
			{
				$found[0]->[1]++;
			}
			else
			{
				push @{ $players{$id}{names} }, [$name, 1];
			}
			$players{$id}->{last_connect} = $record->{date};
			$players{$id}->{connections}++;
		}
		elsif ( $status eq "DISCONNECTED"  && $players{$id}->{last_connect} )
		{
			$players{$id}->{last_disconnect} = $record->{date};
			$players{$id}->{playing_time} += UnixDate( $players{$id}->{last_disconnect}, "%s" ) - UnixDate( $players{$id}->{last_connect}, "%s" )
		}
	}
	
	return \%players;
}

# Parses a line of the logfile
sub parse_log
{
	my $file = shift;
	
	# These are the columns that are parsed out of the logfile
	# There are more, but they are all blank, so no idea what they mean
	# Actually I also have no idea what id2 and id3 are, but they seem to be uniqe per game
	my @columns = qw/ date status name id1 id2 id3 /;

	# Array to store the parsed field data
	my @records;
	
	# These regexes as used to parse a line
	my $re_time   = '(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z)';
	my $re_status = '(DISCONNECTED|CONNECTED|PROTECTED)';
	my $re_error  = '( \(Player_Reject \s conn=\d+ \s error=\d+\) | PLAYER \s BANNED \s \d+ | BANNED | BannedClient )';
	my $re_name   = '(.+?)';
	my $re_id     = '([\da-f]{32}|-)';
	
	open my $in, "<", $file 
		or die "Can't read input file";

	while ( my $line = <$in> )
	{
		my %record;
		my @record;
		
		# No idea what <missing> means, but those lines screw up the parsing
		# so I ignore them
		next if $line =~ /<missing>/;
		
		# Regular log entry
		if ( $line =~ /^ F? '$re_time','$re_status',''?$re_name','$re_id','$re_id','$re_id'/x )
		{
			@record = ( $1, $2, $3, $4, $5, $6 );
		}
		# Connection error
		elsif ( $line =~ /^ F? '$re_time','$re_error',''?$re_name','$re_id','$re_id','$re_id'/x )
		{
			@record = ( $1, $2, $3, $4, $5, $6 );
		}
		else
		{
			print "Error parsing line:\n$line";
		}
		
		# Put the read array into a hash and store it
		if ( @record )
		{
			%record = List::MoreUtils::zip @columns, @record;
			push @records, \%record;
		}
	}

	return @records;
}

# return a number of seconds in a sane format
sub seconds_to_readable_time
{
	my $seconds = shift;
	
	# determine the number of hours in the given number of seconds
	my $hours = int( $seconds / 3600 );
	$seconds = $seconds - ( $hours * 3600 );
	
	# determine the number of minutes in the given number of seconds
	my $minutes = int( $seconds / 60 );
	
	# ditch the leftover seconds and return the resut
	return sprintf "%0d hours, %0d minutes", $hours, $minutes;
}

sub get_user_input
{
	my $message = shift;
	my $default = shift;
	
	print "$message\nHit <Enter> to use the default ($default).\n";
	my $answer = <STDIN>; chomp $answer;
	
	return $answer || $default;
}
